home *** CD-ROM | disk | FTP | other *** search
/ AmigActive 10 / AACD 10.iso / AACD / Utilities / FWCalendar / FWCAddEvent.rexx < prev    next >
OS/2 REXX Batch file  |  2000-04-09  |  64KB  |  1,869 lines
  1. /*
  2.     AddEvent.rexx Macro
  3.     Adds events to calendars created by FWCalendar.rexx
  4.     $VER: FWCAddEvent.rexx v3.78 (11 Mar 2000)
  5.     ©Ron Goertz (goertz@earthlink.net)
  6. */
  7.  
  8. OPTIONS RESULTS
  9. signal on syntax
  10.  
  11. call AddLibraries
  12. bguiopen = bguiopen()
  13. if ErrorCount > 0 then call Cleanup
  14.  
  15. parse source . . . FullCallPath . CallHost
  16. CallHost = strip(CallHost)
  17. ScriptDir = PathPart(FullCallPath)
  18.  
  19. CurrentDir = upper(Pragma('D'))
  20. if right(CurrentDir, 1) ~= ':' then CurrentDir = CurrentDir'/'
  21.  
  22. if (pos('FINALWRITER', CurrentDir) > 0) | (left(CallHost, 6) == 'FINALW') then do
  23.   App     = 'FW'
  24.   AppName = 'FINALWRITER'
  25.   if CallHost == 'REXX' then address value substr(PortList, pos('FINALW.', PortList), 8)
  26.   GETDOCITEMPREFS Decimal; DecimalFormat = result
  27.   DOCITEMPREFS Decimal Period
  28. end
  29. else if (pos('PAGESTREAM', CurrentDir) > 0) | (CallHost == 'PAGESTREAM') then do
  30.   App     = 'PGS'
  31.   AppName = 'PAGESTREAM'
  32.   address 'PAGESTREAM'
  33. end
  34.  
  35. call SetVariables
  36.  
  37. Month = substr(TempDate,5,2)
  38. if left(Month,1) == "0" then Month = right(Month,1)
  39. PrevMonth = Month - 1
  40. if PrevMonth = 0 then PrevMonth = 12
  41. NextMonth = Month + 1
  42. if NextMonth = 13 then NextMonth = 1
  43.  
  44. Year = left(TempDate,4)
  45. if (Year//4 == 0 & Year//100 > 0) | Year//400 == 0 Then MonthLength.2  = 29
  46.  
  47. interpret "StartDate = Day."Date('W', TempDate, 'S')
  48. if (DoExtended == 0) | (StartDate + MonthLength.Month > 35) then MaxDate = MonthLength.Month
  49. else MaxDate = 35 - StartDate
  50.  
  51. FontName = Font.Highlight
  52. FontSize = FSize.Highlight
  53. call GetEvent
  54. exit
  55.  
  56. /*********************************************/
  57. /*              Subroutines                  */
  58. /*********************************************/
  59. /***//*******  AddLibraries (AL) Subroutine  ***********/
  60. AddLibraries:
  61.   PortList     = show('P')
  62.   ErrorCount   = 0
  63.   WarningCount = 0
  64.   Req          = 0
  65.   bguiopen     = 0
  66.   EventFile    = ''
  67.   DefScreen    = ''
  68.  
  69.   Storage         = 'RAM:FWC/'
  70.   Notice$         = 'notice'
  71.   Critical$       = 'Critical error'
  72.   See$            = 'see'
  73.   SeeOutput$      = 'see the output above for details'
  74.   ForDetails$     = 'for details'
  75.   ForwardLog$     = 'Forward log file to'
  76.   Unable$         = 'if you are unable to resolve the problem.'
  77.   ForwardContent$ = 'Forward contents of output to'
  78.   SeeShell$       = 'see the shell output for details'
  79.   OK$             = '_OK'
  80.  
  81.   AL_Libs        = 'rexxsupport.library rexxbgui.library bgui.library'
  82.   AL_MinVersions = ' 34.9                4.0             41.10       '
  83.   AL_Offsets     = '-30                -30              -30          '
  84.   do AL_i = 1 to words(AL_Libs)
  85.     AL_Lib        = word(AL_Libs, AL_i)
  86.     AL_MinVersion = word(AL_MinVersions, AL_i)
  87.     AL_Offset     = word(AL_Offsets, AL_i)
  88.     if exists('LIBS:'AL_Lib) then do
  89.       AL_InstalledVersion = libver(AL_Lib)
  90.       if (AL_InstalledVersion < AL_MinVersion) | (AL_InstalledVersion == 'unknown') then do
  91.         call AddMsg('E', AL_Lib' version 'AL_MinVersion' is required; your version is 'AL_InstalledVersion'.')
  92.       end
  93.       else if pos('rexx', AL_Lib) > 0 then call addlib(AL_lib, 0, AL_Offset, trunc(AL_MinVersion))
  94.     end
  95.     else call AddMsg('E', AL_lib' is required but could not be found.')
  96.   end
  97.  
  98.   AL_Libs        = 'rexxtricks.library'
  99.   AL_MinVersions = '  0               '
  100.   AL_Offsets     = '-30               '
  101.   AL_Variables   = 'RexxTricks        '
  102.   do AL_i = 1 to words(AL_Libs)
  103.     AL_Lib        = word(AL_Libs, AL_i)
  104.     AL_MinVersion = word(AL_MinVersions, AL_i)
  105.     AL_Offset     = word(AL_Offsets, AL_i)
  106.     AL_Variable   = word(AL_Variables, AL_i)
  107.     if exists('LIBS:'AL_lib) then do
  108.       AL_InstalledVersion = libver(AL_lib)
  109.       if (AL_InstalledVersion < AL_MinVersion) | (AL_InstalledVersion == 'unknown') then do
  110.         call AddMsg('W', AL_Lib' version 'AL_MinVersion' is required; your version is 'AL_InstalledVersion'.')
  111.         interpret Al_Variable' = 0'
  112.       end
  113.       else do
  114.         call addlib(AL_lib, 0, AL_Offset, trunc(AL_MinVersion))
  115.         interpret Al_Variable' = 1'
  116.       end
  117.     end
  118.     else interpret Al_Variable' = 0'
  119.   end
  120.  
  121.   if ErrorCount > 0 then call Cleanup
  122.   return
  123. /**/
  124.  
  125. /***//*******  AddMsg (AM) Subroutine  ***********/
  126. AddMsg:
  127.   parse arg AM_MsgType, AM_Msg
  128.  
  129.   if AM_MsgType == 'E' then do
  130.     ErrorCount = ErrorCount + 1
  131.     Error.ErrorCount = AM_Msg
  132.   end
  133.   else do
  134.     WarningCount = WarningCount + 1
  135.     Warning.WarningCount = AM_Msg
  136.   end
  137.  
  138.   return
  139. /**/
  140.  
  141. /***//*******  Cleanup () Subroutine  ***********/
  142. Cleanup:
  143.   signal off syntax
  144.  
  145.   if VariablesSet == 1 then do
  146.     interpret UserPrefs
  147.     if Req ~= 0 then call bguiwinclose(Req)
  148.     if App == 'FW' then do
  149.       SELECTOBJECT
  150.       REDRAW
  151.       if upper(DecimalFormat) == 'COMMA' then DocItemPrefs Decimal Comma
  152.     end
  153.     else if App == 'PGS' then do
  154.       SELECTOBJECT None WINDOW winName
  155.       if WindowRefreshed ~= 1 then do
  156.         REFRESH ON
  157.         REFRESHWINDOW WINDOW winName
  158.       end
  159.     end
  160.   end
  161.  
  162.   LogOpen = open('FWCLog', Storage'FWCLog.txt', 'W')
  163.   if LogOpen == 1 then OutType = 'File'
  164.   if (ErrorCount > 0) & (LogOpen == 0) then do
  165.     LogOpen = 1
  166.     call open('FWCLog', 'CON:10/10/500/300/FWCalendar.rexx Message/WAIT/CLOSE')
  167.     OutType = 'CON'
  168.   end
  169.  
  170.   if LogOpen == 1 then do
  171.     call writeln('FWCLog', '      Macro: 'strip(substr(sourceline(4), pos(':', sourceline(4)) + 1)))
  172.     call writeln('FWCLog', 'Application: 'PgmVersion)
  173.     call writeln('FWCLog', 'Current Dir: 'CurrentDir)
  174.     call writeln('FWCLog', ' Script Dir: 'ScriptDir)
  175.     call writeln('FWCLog', '       Host: 'CallHost)
  176.     call writeln('FWCLog', '   Calendar: 'Month.Month' 'Year||'0a'x)
  177.   end
  178.  
  179.   if (ErrorCount > 0) | (WarningCount > 0) then do
  180.     do i = 1 to ErrorCount
  181.       call writeln('FWCLog', Error.i)
  182.     end
  183.  
  184.     do i = 1 to WarningCount
  185.       call writeln('FWCLog', Warning.i)
  186.     end
  187.  
  188.     if exists(PrefsFile) then do
  189.       call writeln('FWCLog', '0a'x||' -- 'PrefsFile' -- ')
  190.       call open('DataFile', PrefsFile)
  191.         do until eof('DataFile')
  192.           Ln = ReadLn('DataFile')
  193.           if pos('End Pass One', Ln) > 0 then leave
  194.           call writeln('FWCLog', Ln)
  195.         end
  196.       call close('DataFile')
  197.     end
  198.  
  199.     if EventFile ~= '' then do
  200.       call writeln('FWCLog', '0a'x||' -- 'EventFile' -- ')
  201.       call open('DataFile', EventFile)
  202.         do until eof('DataFile')
  203.           call writeln('FWCLog', ReadLn('DataFile'))
  204.         end
  205.       call close('DataFile')
  206.     end
  207.  
  208.     if ErrorCount > 0 then ErrorType = Critical$
  209.     else ErrorType = Noncritical$
  210.     FileMsg = ErrorType' ... 'See$' 'Storage'FWCLog.txt 'ForDetails$'.'||'0a'x||ForwardLog$': Ron Goertz <goertz@earthlink.net>'||'0a'x||Unable$
  211.     Conbgui = ErrorType' ... 'SeeShell$'.'||'0a'x||ForwardContent$||'0a'x||'Ron Goertz <goertz@earthlink.net>'||'0a'x||Unable$
  212.     ConCon  = ErrorType' ... 'SeeOutput$'.'||'0a'x||ForwardContent$||'0a'x||'Ron Goertz <goertz@earthlink.net>'||'0a'x||Unable$
  213.     if (OutType == 'File') & (bguiopen == 1) then call bguireq('1B'x||'c'FileMsg,'*'OK$,'FWCalendar 'Notice$,,PubScreen)
  214.     if (OutType == 'File') & (bguiopen == 0) then do
  215.       call open('CON', 'CON:10/10/500/300/FWCAddEvent notice/WAIT/CLOSE')
  216.         call writeln('CON', FileMsg)
  217.       call close('CON')
  218.     end
  219.     if (OutType == 'CON') & (bguiopen == 1) then call bguireq('1B'x||'c'Conbgui,'*'OK$,'FWCalendar 'Notice$,,PubScreen)
  220.     if (OutType == 'CON') & (bguiopen == 0) then call Writeln('FWCLog', '0a'x||ConCon)
  221.   end
  222.   else do
  223.     address command 'delete >NIL: 'Storage'FWC'App'Temp.txt quiet'
  224.     if LogOpen == 1 then call writeln('FWCLog', 'No errors.')
  225.   end
  226.  
  227.   address command 'delete >NIL: 'Storage'FWCTemp quiet'
  228.   call close('FWCLog')
  229.   if bguiopen = 1 then call bguiclose()
  230.   if DefScreen ~= '' then call setdefaultpubscreen(DefScreen)
  231.   exit
  232. /**/
  233.  
  234. /***//*******  ConvertDay (CD) Subroutine ***********/
  235. ConvertDay:
  236.   parse arg CD_Day
  237.   If upper(left(CD_Day,1)) == "P" then CD_Day = substr(CD_Day,2) - MonthLength.PrevMonth
  238.   If upper(left(CD_Day,1)) == "N" then CD_Day = substr(CD_Day,2) + MonthLength.Month
  239.   return CD_Day
  240. /**/
  241.  
  242. /***//*******  DrawBox (DB) Subroutine  ***********/
  243. DrawBox:
  244.   parse arg DB_x1, DB_y1, DB_Width, DB_Height, DB_Weight, DB_Color, DB_FillBool, DB_FillColor, DB_Tint
  245.  
  246.   if DB_FillColor == '<'Clear$'>' then DB_FillBool = 0
  247.  
  248.   if App == 'FW' then do
  249.     if DB_Weight == 'HL' then DB_Weight = 'Hairline'
  250.     else if DB_Weight == 0 then do
  251.       DB_Weight = 'None'
  252.       if DB_FillColor ~= '<'Clear$'>' then DB_Color = DB_FillColor
  253.     end
  254.  
  255.     if DB_FillBool == 1 then DB_FillBool = 'Solid'
  256.     else do
  257.       DB_FillBool = 'Transparent'
  258.       DB_FillColor = DB_Color
  259.     end
  260.  
  261.     BOXPREFS LINEWT DB_Weight LINECOLOR '"'DB_Color'"' FILL DB_FillBool FILLCOLOR '"'DB_FillColor'"'
  262.     DRAWBOX 1 DB_x1 DB_y1 DB_Width DB_Height; DB_id = result
  263.   end
  264.   else if App == 'PGS' then do
  265.     if DB_Weight == 'HL' then DB_Weight = 0.3pt
  266.     else DB_Weight = DB_Weight'pt'
  267.  
  268.     if DB_FillBool == 1 then DB_FillBool = 'ON'
  269.     else DB_FillBool = 'OFF'
  270.  
  271.     If DB_Weight == 0 then DB_LineBool = 'OFF'
  272.     else DB_LineBool = 'ON'
  273.  
  274.     DRAWBOX DB_x1 DB_y1 DB_x1 + DB_Width DB_y1 + DB_Height WINDOW winName; DB_id = result
  275.     STROKED DB_LineBool OBJECTID DB_id WINDOW winName
  276.     SETSTROKEWEIGHT DB_Weight STROKENUMBER 0 OBJECTID DB_id WINDOW winName
  277.     SETCOLORSTYLE '"'DB_Color'"' COLORNUMBER 0 STROKENUMBER 0 OBJECTID DB_id WINDOW winName
  278.     FILLED DB_FillBool OBJECTID DB_id WINDOW winName
  279.     SETCOLORSTYLE '"'DB_FillColor'"' COLORNUMBER 0 FILL OBJECTID DB_id WINDOW winName
  280.     SETCOLORTINT DB_Tint FILL OBJECTID DB_id WINDOW winName
  281.   end
  282.   return DB_id
  283. /**/
  284.  
  285. /***//*******  GetEvent (GE) Subroutine  ***********/
  286. GetEvent:
  287.   do GE_i = 0 to 15
  288.     linelist_.GE_i = GE_i
  289.   end
  290.   linelist_.COUNT = min(RowsThatFit, 16)
  291.  
  292.   call bguilist("eventlist_",Event$,File$)
  293.   call bguilist("FrequencyList", Once$, Weekly$, Biweekly$)
  294.  
  295.   GE_StartOrEnd   = 1
  296.   GE_StartDate    = ""
  297.   GE_EndDate      = ""
  298.   GE_Boxed.0      = ""
  299.   GE_Boxed.128    = "B"
  300.   GE_Weekly.0     = ""
  301.   GE_Weekly.1     = "W"
  302.   GE_Weekly.2     = "2"
  303.   GadID.          = ''
  304.   GE_Arg.         = ''
  305.   GE_i            = 0
  306.   GE_Day          = 0
  307.   GE_PrevDay      = MonthLength.PrevMonth - StartDate
  308.   GE_NextDay      = 0
  309.  
  310.   Req = OpenBusy(PrepReq$'...', 45)
  311.   do while (GE_i < 6)
  312.     GE_j = 0
  313.     do while (GE_j < 7)
  314.       call UpdateBusy(Req, 1)
  315.       GE_SerialPosition = (GE_i * 7) + GE_j
  316.       GE_Button = GE_SerialPosition + 1
  317.       if (GE_SerialPosition >= StartDate) & (GE_SerialPosition < StartDate + MonthLength.Month) then Do
  318.         GE_Day = GE_Day + 1
  319.         interpret "GadID."GE_Button" = bguibutton('"GE_Button"_', GE_Day)"
  320.         GadID = GetID(GE_Button'_')
  321.         GE_Arg.GadID = 'C 'left(Month.Month, 3)' 'GE_Day
  322.       end
  323.       else do
  324.         if GE_SerialPosition < StartDate then Do
  325.           GE_PrevDay = GE_PrevDay + 1
  326.           interpret "GadID."GE_Button" = bguibutton('"GE_Button"_', GE_PrevDay)"
  327.           GadID = GetID(GE_Button'_')
  328.           GE_Arg.GadID = 'P 'left(Month.PrevMonth, 3)' 'GE_PrevDay
  329.         end
  330.         else do
  331.           GE_NextDay = GE_NextDay + 1
  332.           interpret "GadID."GE_Button" = bguibutton('"GE_Button"_', GE_NextDay)"
  333.           GadID = GetID(GE_Button'_')
  334.           GE_Arg.GadID = 'N 'left(Month.NextMonth, 3)' 'GE_NextDay
  335.         end
  336.       end
  337.       GE_j = GE_j + 1
  338.     end
  339.     GE_i = GE_i + 1
  340.     if GE_SerialPosition >= StartDate + MonthLength.Month - 1 then leave
  341.   end
  342.  
  343.   DateButtons = bguihgroup(GadID.1""GadID.2""GadID.3""GadID.4""GadID.5""GadID.6""GadID.7)||,
  344.                 bguihgroup(GadID.8""GadID.9""GadID.10""GadID.11""GadID.12""GadID.13""GadID.14)||,
  345.                 bguihgroup(GadID.15""GadID.16""GadID.17""GadID.18""GadID.19""GadID.20""GadID.21)||,
  346.                 bguihgroup(GadID.22""GadID.23""GadID.24""GadID.25""GadID.26""GadID.27""GadID.28)
  347.   if GE_i > 4 then DateButtons = DateButtons''bguihgroup(GadID.29""GadID.30""GadID.31""GadID.32""GadID.33""GadID.34""GadID.35)
  348.   if GE_i > 5 then DateButtons = DateButtons''bguihgroup(GadID.36""GadID.37""GadID.38""GadID.39""GadID.40""GadID.41""GadID.42)
  349.  
  350.   g=bguivgroup(,
  351.     bguihgroup(,
  352.       bguicycle("eventtype_",,"eventlist_")bguilayout(LGO_FixMinWidth,1,LGO_FixMinHeight,1)||,
  353.       bguistring("event_",,,256)bguilayout(LGO_FixMinHeight,1),
  354.     )||,
  355.     bguihgroup(,
  356.       bguistring('fontvalue_',Font$,FontName,256)bguilayout(LGO_Weight,50,LGO_FixMinHeight,1)||,
  357.       bguistring('fontsize_',,FontSize,8)bguilayout(LGO_Weight,10,LGO_FixMinHeight,1)||,
  358.       bguiibutton('addfont_','B','F')bguilayout(LGO_FixMinWidth,1,LGO_FixMinHeight, 1)||,
  359.       bguibutton("reset_",Reset$)bguilayout(LGO_FixMinWidth,1,LGO_FixMinHeight,1),
  360.     )||,
  361.     bguihgroup(,
  362.       bguivgroup(,
  363.         bguiinfo('dummy_',,esc'c'Month.Month)bguilayout(LGO_FixMinHeight, 1)||,
  364.         bguihgroup(,
  365.           bguiinfo("dummy_",,esc"c"left(Day.0,1))||,
  366.           bguiinfo("dummy_",,esc"c"left(Day.1,1))||,
  367.           bguiinfo("dummy_",,esc"c"left(Day.2,1))||,
  368.           bguiinfo("dummy_",,esc"c"left(Day.3,1))||,
  369.           bguiinfo("dummy_",,esc"c"left(Day.4,1))||,
  370.           bguiinfo("dummy_",,esc"c"left(Day.5,1))||,
  371.           bguiinfo("dummy_",,esc"c"left(Day.6,1)),
  372.         )||,
  373.         DateButtons,
  374.       )||,
  375.       bguivgroup(,
  376.         bguiinfo("startchoice_",esc"r"Start$,"")bguilayout(LGO_FixMinHeight, 1)||,
  377.         bguiinfo("endchoice_",esc"r"End$,"")bguilayout(LGO_FixMinHeight, 1)||,
  378.         bguicycle('textcolor_',esc"r"TextColor$,'TextColorList')bguilayout(LGO_FixMinWidth,1,LGO_FixMinHeight, 1)||,
  379.         bguicycle("linechoice_",esc"r"Line$,"linelist_")bguilayout(LGO_FixMinWidth,1,LGO_FixMinHeight,1)||,
  380.         bguicheckbox("boxchoice_",esc"r"Boxed$,0)bguilayout(LGO_FixMinWidth,1,LGO_FixMinHeight,1)||,
  381.         bguicycle('boxcolor_',esc"r"BoxColor$,'ColorList')bguilayout(LGO_FixMinWidth,1,LGO_FixMinHeight, 1)||,
  382.         bguicycle("weeklychoice_",esc"r"Frequency$,'FrequencyList')bguilayout(LGO_FixMinWidth,1,LGO_FixMinHeight,1)||,
  383.         bguihgroup(,
  384.           bguibutton("OK_",OK$)bguilayout(LGO_FixMinHeight,1)||,
  385.           bguibutton("cancel_",Cancel$)bguilayout(LGO_FixMinHeight,1),
  386.         ),
  387.       ),
  388.     ),
  389.   ,"-1","-1")
  390.  
  391.   call UpdateBusy(Req, 1)
  392.   GE_winID=bguiwindow(EnterEventInfo$,g,5,0,,PubScreen)
  393.   call UpdateBusy(Req, 1)
  394.  
  395.   if App == 'PGS' then do
  396.     FontGroup=bguivgroup(bguilistview('fontlistview_',,'FontList'))
  397.     call UpdateBusy(Req, 1)
  398.     FontwinID=bguiwindow(SelectFont$,FontGroup,20,50,,PubScreen)
  399.   end
  400.  
  401.   call bguiset(obj.linechoice_,GE_winID,CYC_Active,1)
  402.   call bguiset(obj.boxcolor_,GE_winID,CYC_Active,max(0, MemberID(Background.AddEvent,'ColorList', ColorList.Count, 0)))
  403.   call bguiset(obj.textcolor_,GE_winID,CYC_Active,max(0, MemberID(Color.AddEvent,'ColorList', ColorList.Count, 0)))
  404.   call bguiset(obj.event_,,BT_Key,EventKey)
  405.   call bguiwintabcycleorder(GE_winID,obj.event_||obj.fontsize_)
  406.  
  407.   if bguiwinopen(GE_winID)=0 then bguierror(12)
  408.  
  409.   if Req ~= 0 then call bguiwinclose(Req)
  410.   Req = 0
  411.  
  412.   id=0
  413.   do while 1
  414.     call bguiwinwaitevent(GE_winID,"ID")
  415.     select
  416.       when (id == id.cancel_) | (id == id.winclose) then call Cleanup
  417.       when id == id.winactive then nop
  418.       when id == id.wininactive then nop
  419.       when id == id.event_ then nop
  420.       when id == id.linechoice_ then nop
  421.       when id == id.boxchoice_ then nop
  422.       when id == id.textcolor_ then nop
  423.       when id == id.boxcolor_ then nop
  424.       when id == id.weeklychoice_ then nop
  425.       when id == id.reset_ then do
  426.         FontName = Font.Highlight
  427.         FontSize = FSize.Highlight
  428.         call bguiset(obj.fontvalue_, GE_winID, STRINGA_TextVal,FontName)
  429.         call bguiset(obj.fontsize_, GE_winID, STRINGA_TextVal,FontSize)
  430.       end
  431.       when id == id.fontvalue_ then do
  432.         call bguireq('1b'x||"c"MustUse$,"*"OK$,'',GE_winID)
  433.         call bguiset(obj.fontvalue_, GE_winID,STRINGA_TextVal, FontName)
  434.       end
  435.       when id == id.fontsize_ then nop
  436.       when id == id.addfont_ then do
  437.         call bguiwinbusy(GE_winID)
  438.         if App == 'FW' then do
  439.           FontFile = bguifilereq(CurrentDir'FWFonts/SWOLFonts/', SelectFont$, GE_winID,,'#?')
  440.           if FontFile ~= '' then call bguiset(obj.fontvalue_, GE_winID, STRINGA_TextVal,FontFile)
  441.         end
  442.         else if App == 'PGS' then do
  443.           call bguiwinopen(FontwinID)
  444.           do while 1
  445.             call bguiwinwaitevent(FontwinID,'ID')
  446.             if id == id.winclose then leave
  447.             if id == id.fontlistview_ then do
  448.               call bguiset(obj.fontvalue_, GE_winID, STRINGA_TextVal,bguiget(obj.fontlistview_, LISTV_LastClicked))
  449.               leave
  450.             end
  451.           end
  452.           call bguiwinclose(FontwinID)
  453.         end
  454.         call bguiwinready(GE_winID)
  455.         FontName = bguiget(obj.fontvalue_, STRINGA_TextVal)
  456.       end
  457.       when id == id.ok_ then do
  458.         GE_EventValue = bguiget(obj.event_, STRINGA_TextVal)
  459.         GE_BoxValue   = bguiget(obj.boxchoice_, GA_Selected)
  460.         if GE_StartDate = "" then call bguireq(EnterStartDate$'...','*'OK$,'FWCAddEvent 'Notice$,GE_winID)
  461.         else if (GE_EventValue == "") & (GE_Boxed.GE_BoxValue == "") then call bguireq(EnterEvent$'...','*'OK$,'FWCAddEvent 'Notice$,GE_winID)
  462.         else do
  463.           GE_WeeklyValue  = bguiget(obj.weeklychoice_, CYC_Active)
  464.           GE_EventType = bguiget(obj.eventtype_, CYC_Active)
  465.  
  466.           EventData = "   EventType = "Type.GE_EventType||'0a'x||,
  467.                       " EnteredFont = "strip(FontName)||'0a'x||,
  468.                       " EnteredSize = "strip(bguiget(obj.fontsize_, STRINGA_TextVal))||'0a'x||,
  469.                       " EnteredDay1 = "strip(GE_StartDate)||'0a'x||,
  470.                       " EnteredDay2 = "strip(GE_EndDate)||'0a'x||,
  471.                       " EnteredLine = "bguiget(obj.linechoice_, CYC_Active)||'0a'x||,
  472.                       "     Options = "GE_Boxed.GE_BoxValue""GE_Weekly.GE_WeeklyValue||'0a'x||,
  473.                       "   TextColor = "value('ColorList.'bguiget(obj.textcolor_, CYC_Active))||'0a'x||,
  474.                       "    BoxColor = "value('ColorList.'bguiget(obj.boxcolor_, CYC_Active))||'0a'x||,
  475.                       "EnteredEvent = "GE_EventValue
  476.  
  477.           call bguiwinclose(GE_winID)
  478.           call ProcessEvent
  479.           call bguiwinopen(GE_winID)
  480.  
  481.           GE_StartOrEnd = 1
  482.           GE_StartDate  = ""
  483.           GE_EndDate    = ""
  484.           call bguiset(obj.startchoice_,GE_winID,INFO_TextFormat,'')
  485.           call bguiset(obj.endchoice_,GE_winID,INFO_TextFormat,'')
  486.         end
  487.       end
  488.       when id == id.eventtype_ then do
  489.         GE_EventType = bguiget(obj.eventtype_, CYC_Active)
  490.         if Type.GE_EventType == Event$ then do
  491.           call bguiset(obj.event_,GE_winID,STRINGA_TextVal,"")
  492.           call bguiset(obj.textcolor_, GE_winID, GA_Disabled, 0)
  493.           call bguiset(obj.boxcolor_, GE_winID, GA_Disabled, 0)
  494.           call bguiset(obj.linechoice_, GE_winID, GA_Disabled, 0)
  495.           call bguiset(obj.boxchoice_, GE_winID, GA_Disabled, 0)
  496.           call bguiset(obj.weeklychoice_, GE_winID, GA_Disabled, 0)
  497.           call bguiset(obj.reset_, GE_winID, GA_Disabled, 0)
  498.           call bguiset(obj.addfont_, GE_winID, GA_Disabled, 0)
  499.           call bguiset(obj.fontsize_, GE_winID, GA_Disabled, 0)
  500.           call bguiset(obj.fontvalue_, GE_winID, GA_Disabled, 0)
  501.         end
  502.         else do
  503.           GE_DataFile = bguifilereq(ScriptDir''"FWCAddEvent.data", SelectFile$, GE_winID,DOPATTERNS,PatVar)
  504.           if ~exists(GE_DataFile) then do
  505.             call bguireq(GE_DataFile' 'CantFind$'...','*'OK$,'FWCAddEvent 'Notice$,GE_winID)
  506.             GE_DataFile = ''
  507.           end
  508.           if GE_DataFile == '' then do
  509.             call bguiset(obj.eventtype_, GE_winID, CYC_Active, 0)
  510.             call bguiset(obj.textcolor_, GE_winID, GA_Disabled, 0)
  511.             call bguiset(obj.boxcolor_, GE_winID, GA_Disabled, 0)
  512.             call bguiset(obj.linechoice_, GE_winID, GA_Disabled, 0)
  513.             call bguiset(obj.boxchoice_, GE_winID, GA_Disabled, 0)
  514.             call bguiset(obj.weeklychoice_, GE_winID, GA_Disabled, 0)
  515.             call bguiset(obj.reset_, GE_winID, GA_Disabled, 0)
  516.             call bguiset(obj.addfont_, GE_winID, GA_Disabled, 0)
  517.             call bguiset(obj.fontsize_, GE_winID, GA_Disabled, 0)
  518.             call bguiset(obj.fontvalue_, GE_winID, GA_Disabled, 0)
  519.           end
  520.           else do
  521.             call bguiset(obj.event_, GE_winID, STRINGA_TextVal,GE_DataFile)
  522.             call bguiset(obj.textcolor_, GE_winID, GA_Disabled, 1)
  523.             call bguiset(obj.boxcolor_, GE_winID, GA_Disabled, 1)
  524.             call bguiset(obj.linechoice_, GE_winID, GA_Disabled, 1)
  525.             call bguiset(obj.boxchoice_, GE_winID, GA_Disabled, 1)
  526.             call bguiset(obj.weeklychoice_, GE_winID, GA_Disabled, 1)
  527.             call bguiset(obj.reset_, GE_winID, GA_Disabled, 1)
  528.             call bguiset(obj.addfont_, GE_winID, GA_Disabled, 1)
  529.             call bguiset(obj.fontsize_, GE_winID, GA_Disabled, 1)
  530.             call bguiset(obj.fontvalue_, GE_winID, GA_Disabled, 1)
  531.           end
  532.         end
  533.       end
  534.       otherwise do
  535.         GE_StartOrEnd = 1 - GE_StartOrEnd
  536.         GE_ReturnDate = strip(substr(GE_Arg.id, 1, 1)""right(GE_Arg.id, 2), "B", "C")
  537.         GE_Date = substr(GE_Arg.id, 3)
  538.         if GE_StartOrEnd == 0 then do
  539.           call bguiset(obj.startchoice_,GE_winID,INFO_TextFormat,esc"l"GE_Date)
  540.           GE_StartDate = GE_ReturnDate
  541.         end
  542.         else do
  543.           call bguiset(obj.endchoice_,GE_winID,INFO_TextFormat,esc"l"GE_Date)
  544.           GE_EndDate = GE_ReturnDate
  545.         end
  546.       end
  547.     end
  548.   end
  549.   exit
  550. /**/
  551.  
  552. /***//*******  GetFontWidth (GFW) Subroutine  *********/
  553. GetFontWidth:
  554.   parse arg GFW_FontType, GFW_Char
  555.  
  556.   GFW_ID = PrintText(1, 1, GFW_FontType, 'N', White$, Width.GFW_FontType, GFW_Char)
  557.   if App == 'FW' then do
  558.     REDRAW
  559.     GETOBJECTCOORDS GFW_ID; parse var RESULT . . . GFW_Width .
  560.     DELETEOBJECT GFW_ID
  561.   end
  562.   else if App == 'PGS' then do
  563.     GETTEXTOBJ POSITION GFW_Text OBJECTID GFW_ID WINDOW winName
  564.     GFW_Width = GFW_Text.Right - GFW_Text.Left
  565.     DELETEOBJECT OBJECTID GFW_ID WINDOW winName
  566.   end
  567. return GFW_Width
  568. /**/
  569.  
  570. /***//*******  GetHeight (GH) Subroutine  ***********/
  571. GetHeight:
  572.   parse arg GH_FontType
  573.  
  574.   if App == 'FW' then do
  575.     TEXTBLOCKTYPEPREFS SIZE FSize.GH_FontType FONT Font.GH_FontType
  576.     DRAWTEXTBLOCK 1 1 1 'A'; GH_id = result
  577.     GETOBJECTCOORDS GH_id; Parse Var result . . . . GH_Text.Height
  578.     DELETEOBJECT GH_id
  579.   end
  580.   else if App == 'PGS' then do
  581.     DRAWTEXTOBJ 0 0 WINDOW winName; GH_id = result
  582.     SELECTTEXT AT 0 0 WINDOW winName
  583.     BEGINCOMMANDCAPTURE
  584.       SETLEADING RELATIVE 100
  585.       SETTYPESIZE FSize.GH_FontType WINDOW winName
  586.       SETFONT Font.GH_FontType WINDOW winName
  587.     ENDCOMMANDCAPTURE
  588.     INSERT 'A' WINDOW winName
  589.     GETTEXTOBJ POSITION GH_Text OBJECTID GH_id WINDOW winName
  590.     GH_Text.Height = GH_Text.Bottom - GH_Text.Top
  591.     DELETEOBJECT OBJECTID GH_id WINDOW winName
  592.   end
  593.   return GH_Text.Height
  594. /**/
  595.  
  596. /***//*******  GetID (GI) Subroutine  ***********/
  597. GetID:
  598. parse arg GI_var
  599.  
  600. return id.GI_var
  601. /**/
  602.  
  603. /***//*******  GetLogInfo () Subroutine  ***********/
  604. GetLogInfo:
  605.   if ~exists(Storage'FWC'App'Temp.txt') then address command 'list >'Storage'FWC'App'Temp.txt 'AppName'#? lformat %N'
  606.   if open('Temp', Storage'FWC'App'Temp.txt') ~= 0 then do
  607.     do while ~eof('Temp')
  608.       PgmName = readln('Temp')
  609.       if pos('.', PgmName) == 0 then leave
  610.     end
  611.     call close('Temp')
  612.   end
  613.  
  614.   if ~exists(Storage'FWC'App'VersionInfo.txt') then address command 'version >'Storage'FWC'App'VersionInfo.txt 'PgmName
  615.  
  616.   call open('Temp', Storage'FWC'App'VersionInfo.txt')
  617.     PgmVersion = readln('Temp')
  618.   call close('Temp')
  619.  
  620.   if left(PgmVersion, 34) == 'Could not find version information' then do
  621.     if App == 'FW' then do
  622.       call open('Temp', CurrentDir''PgmName)
  623.         /* Desired string at 325365 for v 5.06 */
  624.         /* Desired string at 333771 for FW97   */
  625.         FileOffset = 325300
  626.         call seek('Temp', FileOffset, 'B')
  627.         do until (EndPos ~= 0) | (PrevOffset = FileOffset)
  628.           PrevOffset = FileOffset
  629.           Chunk = readch('Temp', 10000)
  630.           EndPos = pos('Created', Chunk)
  631.           if EndPos == 0 then FileOffset = seek('Temp', -100, 'C')
  632.         end
  633.         if EndPos == 0 then PgmVersion = 'Final Writer - version unknown'
  634.         else do
  635.           StartPos = lastpos('Final', Chunk, EndPos)
  636.           EndPos = pos('00'x||'00'x, Chunk, StartPos)
  637.           PgmVersion = substr(Chunk, StartPos, EndPos - StartPos - 1)
  638.         end
  639.       call close('Temp')
  640.       call open('Temp', Storage'FWC'App'VersionInfo.txt', 'W')
  641.         call writeln('Temp', PgmVersion)
  642.       call close('Temp')
  643.     end
  644.     else PgmVersion = PgmName" - can't find version info"
  645.   end
  646.  
  647.   return
  648. /**/
  649.  
  650. /***//*******  GetWidth (GW) Subroutine  ***********/
  651. GetWidth:
  652.   parse arg GW_ID
  653.  
  654.   if App = 'FW' then do
  655.     GETOBJECTCOORDS GW_ID
  656.     Parse Var result . . . GW_width .
  657.   end
  658.   else if App == 'PGS' then do
  659.     SELECTOBJECT OBJECTID GW_ID  WINDOW winName
  660.     GETOBJECT BOUNDINGBOX GW_Temp WINDOW winName
  661.     GW_width = GW_Temp.Right - GW_Temp.Left
  662.   end
  663.  
  664.   return GW_width
  665. /**/
  666.  
  667. /***//*******  LibVer (LV) Subroutine  *********/
  668. LibVer: /* Retrieve the version number of a library */
  669.   parse arg LV_libname
  670.   if right(LV_libname,8) ~= '.library' then LV_libname = LV_libname'.library'
  671.   address command 'version' 'libs:'LV_Libname '>env:LibVer'
  672.   if open('Temp', 'env:LibVer') then do
  673.     LV_libver = word(readln('Temp'), 2)
  674.     call close('Temp')
  675.   end
  676.   else LV_libver = 'unknown'
  677.   return LV_libver
  678. /**/
  679.  
  680. /***//*******  MemberID (MI) Subroutine  *********/
  681. MemberID:
  682.   parse arg MI_Member, MI_Array, MI_Count, MI_Start
  683.  
  684.   if MI_Start == 0 then MI_Count = MI_Count - 1
  685.   do MI_i = MI_Start to MI_Count
  686.     if upper(value(MI_Array'.'MI_i)) == upper(MI_Member) then return MI_i
  687.   end
  688.   return -1
  689. /**/
  690.  
  691. /***//*******  NameOnly (NO) Subroutine  ***********/
  692. NameOnly:
  693.   parse arg NO_fontname
  694.   return substr(NO_fontname, max(lastpos(':', NO_fontname), lastpos('/', NO_fontname)) + 1)
  695. /**/
  696.  
  697. /***//*******  OpenBusy (OB) Subroutine  ***********/
  698. OpenBusy:
  699.   parse arg OB_BusyTitle, OB_EventCount
  700.  
  701.   OB_ProgressGroup=bguivgroup(,
  702.         bguiinfo('OB_dummy',,'1B'x||'c'OB_BusyTitle)bguilayout(LGO_FixMinHeight,1)||,
  703.         bguiprogress('OB_prog2_',,0,OB_EventCount)||,
  704.         bguihgroup(,
  705.                 bguivarspace(50)bguilayout(LGO_FixMinHeight,1)||,
  706.                 bguibutton('OB_cancel_',Cancel$)bguilayout(LGO_FixMinHeight,1)||,
  707.                 bguivarspace(50)bguilayout(LGO_FixMinHeight,1),
  708.         ,,,,'W'),
  709.   ,-2,-2)
  710.  
  711.   OB_ProgressWindow = bguiwindow(PleaseWait$'...',OB_ProgressGroup,,2,,PubScreen)
  712.   if bguiwinopen(OB_ProgressWindow) = 0 then call Cleanup
  713.  
  714.   Progress = 0
  715.  
  716. return OB_ProgressWindow
  717. /**/
  718.  
  719. /***//*******  ParseVariables (PV) Subroutine  ***********/
  720. ParseVariables:
  721.   parse arg PV_Line
  722.  
  723.   PV_String = translate(PV_Line,,'=(+-*/,)"'||"'",' ')
  724.   PV_VarString = ''
  725.   PV_Var.      = '00'x
  726.   PV_LongVar   = 4
  727.   PV_LIT       = ''
  728.   PV_Count     = 0
  729.  
  730.   do PV_i = 1 to words(PV_String)
  731.     PV_Word = word(PV_String, PV_i)
  732.     if pos(PV_Word'(', PV_Line) > 0 then iterate
  733.     if datatype(PV_Word) == 'CHAR' then do
  734.       if symbol(PV_Word) == 'LIT' then PV_LIT = PV_LIT''PV_Word', '
  735.       if symbol(PV_Word) == 'VAR' then do
  736.         PV_LongVar = max(PV_LongVar, length(PV_Word) + 2)
  737.         if PV_Var.PV_Word == '00'x then do
  738.           PV_Count = PV_Count + 1
  739.           PV_Var.PV_Count = PV_Word
  740.           PV_Var.PV_Word  = value(PV_Word)
  741.         end
  742.         if pos('.', PV_Word) > 0 then do
  743.           PV_CompoundParts = subword(translate(PV_Word,,'.', ' '), 2)
  744.           do PV_j = 1 to words(PV_CompoundParts)
  745.             PV_Subword = word(PV_CompoundParts, PV_j)
  746.             if PV_Var.PV_SubWord == '00'x then do
  747.               PV_Count = PV_Count + 1
  748.               PV_Var.PV_Count = PV_SubWord
  749.               if symbol(PV_Subword) == 'LIT' then PV_Var.PV_SubWord  = 'LIT'
  750.               else PV_Var.PV_SubWord  = value(PV_SubWord)
  751.             end
  752.           end
  753.         end
  754.       end
  755.     end
  756.   end
  757.  
  758.   do PV_i = 1 to PV_Count
  759.     PV_Word = PV_Var.PV_i
  760.     if length(PV_Var.PV_Word) > 50 then PV_Var.PV_Word = left(PV_Var.PV_Word, 50)'...'
  761.     PV_Var.PV_Word = translate(PV_Var.PV_Word,,'0a'x||'0d'x||'00'x,'bb'x)
  762.     PV_VarString = PV_VarString''right(PV_Word, PV_LongVar)' = 'PV_Var.PV_Word||'0a'x
  763.   end
  764.  
  765.   if PV_LIT ~= '' then PV_VarString = right('LIT', PV_LongVar)' = 'strip(PV_LIT, 'B', ' ,')||'0a'x||PV_VarString
  766.  
  767.   return PV_VarString
  768. /**/
  769.  
  770. /***//*******  PathPart (PP) Subroutine ***********/
  771. PathPart:
  772.   parse arg PP_FileWithPath
  773.   return left(PP_FileWithPath, max(lastpos(':', PP_FileWithPath), lastpos('/', PP_FileWithPath)))
  774. /**/
  775.  
  776. /***//*******  PrintText (PT) Subroutine  ***********/
  777. PrintText:
  778.   parse arg PT_Left, PT_Top, PT_FontType, PT_Style, PT_Color, PT_Width, PT_Text
  779.  
  780.   if upper(PT_Style) == 'N' then PT_Font = Font.PT_FontType
  781.   else PT_Font = Bold.PT_FontType
  782.  
  783.   if App == 'FW' then do
  784.     if left(PT_Text, 1) == '"' then PT_Text = '""'PT_Text
  785.     PT_Top = PT_Top + TextAdj * Height.PT_FontType
  786.     TEXTBLOCKTYPEPREFS SIZE FSize.PT_FontType WIDTH trunc(PT_Width) COLOR '"'PT_Color'"' FONT PT_Font
  787.     DRAWTEXTBLOCK 1 PT_Left PT_Top PT_Text; PT_id = result
  788.   end
  789.   else if App == 'PGS' then do
  790.     DRAWTEXTOBJ PT_Left PT_Top WINDOW winName; PT_id = result
  791.     SELECTTEXT AT PT_Left PT_Top WINDOW winName
  792.     BEGINCOMMANDCAPTURE
  793.       SETLEADING RELATIVE 100
  794.       SETTYPESIZE FSize.PT_FontType WINDOW winName
  795.       SETTYPEWIDTH PT_Width WINDOW winName
  796.       SETFONT PT_Font WINDOW winName
  797.       SETCOLORSTYLE '"'PT_Color'"' COLORNUMBER 0 FILL TEXT WINDOW winName
  798.     ENDCOMMANDCAPTURE
  799.     if pos('"', PT_Text) > 0 then do
  800.       call open('IFile', Storage'Text2Insert.txt', 'W')
  801.         call WriteLn('IFile', PT_Text)
  802.       call close('IFile')
  803.       INSERTTEXT FILE Storage'Text2Insert.txt' FILTER ASCII WINDOW winName
  804.     end
  805.     else INSERT '"'PT_Text'"' WINDOW winName
  806.   end
  807.   return PT_id
  808. /**/
  809.  
  810. /***//*******  ProcessEvent (PE) Subroutine  ***********/
  811. ProcessEvent:
  812.   Day1 = ''
  813.   Day2 = ''
  814.   EnteredLine = 1
  815.   Options = ''
  816.   EnteredEvent = ''
  817.   Box = 0
  818.   Weekly = 0
  819.   WindowRefreshed = 0
  820.  
  821.   if EventData == 0 then call CleanUp
  822.   call openv('EventData')
  823.     do until eofv('EventData')
  824.       PE_Ln = readvln('EventData')
  825.       interpret strip(word(PE_Ln, 1))' = strip(subword(PE_Ln, 3))'
  826.     end
  827.   call closev('EventData')
  828.  
  829.   Event. = ''
  830.   if EventType == Event$ then do
  831.     Event.0   = 1
  832.     Event.1   = EventData
  833.     EventFile = ''
  834.   end
  835.   else do
  836.     EventFile = EnteredEvent
  837.     RootDay = ConvertDay(EnteredDay1)
  838.  
  839.     call open('EventFile', EventFile)
  840.       EventCount = 1
  841.       do until eof('EventFile')
  842.         Ln = ReadLn('EventFile')
  843.         if eof('EventFile') == 0 then do
  844.           if left(strip(Ln), 2) == '/*' then iterate
  845.           if Ln == '' then do
  846.             EventCount = EventCount + 1
  847.             iterate
  848.           end
  849.           Event.EventCount = Event.EventCount''Ln||'0a'x
  850.         end
  851.       end
  852.       Event.0 = EventCount
  853.     call close('EventFile')
  854.   end
  855.  
  856.   if Event.0 > 1 then Req = OpenBusy(ProcessEvents$'...', Event.0)
  857.   if App == 'PGS' then do
  858.     REFRESH OFF ALL
  859.   end
  860.   do EC = 1 to Event.0
  861.     if Req ~= 0 then call UpdateBusy(Req, 1)
  862.     Box    = 0
  863.     Weekly = 0
  864.     EnteredFont = Font.Highlight
  865.     EnteredSize = FSize.Highlight
  866.     EnteredDay1 = ''
  867.     EnteredDay2 = ''
  868.     EnteredLine = ''
  869.     EnteredEvent = ''
  870.     Options = ''
  871.     BoxColor = ''
  872.     TextColor = ''
  873.  
  874.     if Event.EC == '' then iterate
  875.     call openv('Event.EC')
  876.       do until eofv('Event.EC')
  877.         PE_Ln = readvln('Event.EC')
  878.         PE_Variable = upper(strip(word(PE_Ln, 1)))
  879.         select
  880.           when PE_Variable == 'FONT' then PE_Variable = 'EnteredFont'
  881.           when PE_Variable == 'SIZE' then PE_Variable = 'EnteredSize'
  882.           when PE_Variable == 'START' then PE_Variable = 'EnteredDay1'
  883.           when PE_Variable == 'END' then PE_Variable = 'EnteredDay2'
  884.           when PE_Variable == 'LINE' then PE_Variable = 'EnteredLine'
  885.           when PE_Variable == 'EVENT' then PE_Variable = 'EnteredEvent'
  886.           when PE_Variable == 'OPTIONS' then nop
  887.           when PE_Variable == 'TEXTCOLOR' then nop
  888.           when PE_Variable == 'BOXCOLOR' then nop
  889.           when PE_Variable == 'ENTEREDFONT' then nop
  890.           when PE_Variable == 'ENTEREDSIZE' then nop
  891.           when PE_Variable == 'ENTEREDDAY1' then nop
  892.           when PE_Variable == 'ENTEREDDAY2' then nop
  893.           when PE_Variable == 'ENTEREDLINE' then nop
  894.           when PE_Variable == 'ENTEREDEVENT' then nop
  895.           otherwise PE_Variable = 'Error'
  896.         end
  897.         if PE_Variable ~= 'Error' then interpret PE_Variable'= strip(subword(PE_Ln, 3))'
  898.       end
  899.     call closev('Event.EC')
  900.     if PE_Variable == 'Error' then do
  901.       call AddMsg('W', 'Line "'PE_Ln'" does not start with a keyword; this event set was skipped.')
  902.       iterate EC
  903.     end
  904.  
  905.     EnteredFont = strip(EnteredFont, 'B', '"'||"'")
  906.     TextColor   = strip(TextColor, 'B', '"'||"'")
  907.     BoxColor    = strip(BoxColor, 'B', '"'||"'")
  908.     Options     = compress(upper(strip(Options, 'B', ' "'||"'")))
  909.  
  910.     if App == 'FW' then EnteredSize = max(trunc(EnteredSize), 4)
  911.  
  912.     FontInfo = compress(EnteredFont''EnteredSize, '. /:')
  913.     if FontKnown.FontInfo == '' then do
  914.       HighestFont = HighestFont + 1
  915.       FontKnown.FontInfo = HighestFont
  916.       Font.HighestFont = EnteredFont
  917.       FSize.HighestFont = EnteredSize
  918.       Height.HighestFont = GetHeight(HighestFont) * Leading/100
  919.     end
  920.     CurrentFont = FontKnown.FontInfo
  921.  
  922.     If EnteredDay2 == "" then EnteredDay2 = EnteredDay1
  923.     If EnteredLine == '' then EnteredLine = 1
  924.     if BoxColor    == '' then BoxColor = Background.AddEvent
  925.     if TextColor   == '' then TextColor = Color.AddEvent
  926.  
  927.     if EventType = Event$ then do
  928.       EnteredDay1 = ConvertDay(EnteredDay1)
  929.       EnteredDay2 = ConvertDay(EnteredDay2)
  930.     end
  931.     else do
  932.       EnteredDay1 = RootDay + EnteredDay1
  933.       EnteredDay2 = RootDay + EnteredDay2
  934.     end
  935.     If EnteredDay1 > EnteredDay2 then Do
  936.       TempDate = EnteredDay1
  937.       EnteredDay1 = EnteredDay2
  938.       EnteredDay2 = TempDate
  939.     End
  940.  
  941.     if pos('B', Options) ~= 0 then Box = 1
  942.     if pos('W', Options) ~= 0 then Weekly = 1
  943.     if pos('2', Options) ~= 0 then Weekly = 2
  944.  
  945.     /* Process Event */
  946.     if App == 'PGS' then REFRESH OFF ALL
  947.     do until Weekly = 0
  948.       Event = EnteredEvent
  949.       Line  = EnteredLine
  950.       Day1  = EnteredDay1
  951.       Day2  = EnteredDay2
  952.       Text. = ''
  953.  
  954.       if Day1 > MaxDate then do
  955.         Weekly = 0
  956.         iterate
  957.       end
  958.       if Day2 > MaxDate then Day2 = MaxDate
  959.  
  960.       If Day1 ~= Day2 then Box = 1
  961.       LineCount = 0
  962.       Do until Day1 > Day2
  963.         Day1Row = trunc((Day1 + StartDate - 1) / 7)
  964.         Day2Row = trunc((Day2 + StartDate - 1) / 7)
  965.         Day1Column = (Day1 + StartDate) - 7 * Day1Row - 1
  966.         Day2Column = (Day2 + StartDate) - 7 * Day2Row - 1
  967.         if (Day1Row == 5) & (DoTopExtraWk == 1) then Day1Row = 0
  968.         if (Day2Row == 5) & (DoTopExtraWk == 1) then Day2Row = 0
  969.  
  970.         if Day1Row == Day2Row then DaySpan = Day2Column - Day1Column + 1
  971.         else DaySpan = 7 - Day1Column
  972.         if Day1 < 1 then CalDate = MonthLength.PrevMonth + Day1
  973.         else if Day1 > MonthLength.Month then CalDate = Day1 - MonthLength.Month
  974.         else CalDate = Day1
  975.         Select
  976.           when CalDate < 10 then HighlightOffset = Width.WidthOfDate1 / 2 + Width.WidthOfDate8
  977.           when CalDate < 20 then HighlightOffset = 1.5 * Width.WidthOfDate1 + Width.WidthOfDate8
  978.           otherwise HighlightOffset = Width.WidthOfDate1 / 2 + 2 * Width.WidthOfDate8
  979.         end
  980.         HighlightOffset = (1 - Box) * HighlightOffset * (Line * Height.Highlight < Height.Date * TextBase)
  981.         If Day1Row < 5 then BoxTop = CalTop + Day1Row * BoxHeight
  982.         else do
  983.           if DoTopExtraWk ~= 1 then BoxTop = CalTop + 4.5 * BoxHeight
  984.           else BoxTop = CalTop
  985.         end
  986.  
  987.         LeftEdge = Margin.Left + Day1Column * BoxWidth + DateOffset + HighlightOffset
  988.         if event ~= '' then do
  989.           Textline = 0
  990.           Text.    = ''
  991.           Text.Textline = event
  992.  
  993.           /* Accomodate user line breaks */
  994.           do until LineBreak = 0
  995.             LineBreak = pos('//', Text.Textline)
  996.             if LineBreak > 0 then do
  997.               Nextline = Textline + 1
  998.               Text.Nextline = substr(Text.Textline, LineBreak + 2)
  999.               Text.Textline = left(Text.Textline, LineBreak - 1)
  1000.               Textline = Nextline
  1001.             end
  1002.           end
  1003.           Textline = 0
  1004.  
  1005.           /* Fit line(s) into allowable space */
  1006.           do until Text.Nextline == ''
  1007.             Nextline = Textline + 1
  1008.             if Box == 1 | Textline == 0 then Indent.Textline = 0
  1009.             else Indent.Textline = 3 * DateOffset
  1010.             AllowedWidth = DaySpan * BoxWidth - 2 * DateOffset - Indent.Textline - HighlightOffset - 2 * DateOffset * Box
  1011.             AllowedBoxWidth = AllowedWidth + 2 * DateOffset
  1012.             if left(Text.Textline, length(TabSub)) == TabSub then do
  1013.               Indent.Textline = TabFactor * DateOffset
  1014.               Text.Textline = substr(Text.Textline, length(TabSub) + 1)
  1015.             end
  1016.  
  1017.             if App == 'FW' & length(Text.Textline) > 37 then do
  1018.               Wordbreak = lastpos(' ', Text.Textline, 37)
  1019.               Text.Nextline = strip(substr(Text.Textline, Wordbreak)' 'Text.Nextline)
  1020.               Text.Textline = strip(left(Text.Textline, Wordbreak))
  1021.             end
  1022.             ID = PrintText(1, 1, CurrentFont, 'N', TextColor, Width.CurrentFont, Text.Textline)
  1023.             if App == 'FW' then redraw
  1024.             TextWidth.Textline = GetWidth(ID)
  1025.             if App == 'FW' then DELETEOBJECT ID
  1026.             else if App == 'PGS' then do
  1027.               SELECTOBJECT OBJECTID ID WINDOW winName
  1028.               DELETEOBJECT OBJECTID ID WINDOW winName
  1029.             end
  1030.  
  1031.             NeededCompression.Textline = min(1, AllowedWidth/TextWidth.Textline)
  1032.             TextWidth.Textline = TextWidth.Textline * NeededCompression.Textline
  1033.             if (NeededCompression.Textline < MinWidth/100) & (Words(Text.Textline) > 1) then do
  1034.               /* Move last word to next line */
  1035.               Wordbreak     = lastpos(' ', Text.Textline)
  1036.               Text.Nextline = strip(substr(Text.Textline, Wordbreak)' 'Text.Nextline)
  1037.               Text.Textline = strip(left(Text.Textline, Wordbreak))
  1038.             end
  1039.             else if Text.Nextline ~= '' then Textline = Textline + 1
  1040.           End
  1041.           LineCount = Textline
  1042.         end
  1043.  
  1044.         if Box then call DrawBox(LeftEdge, BoxTop + Line * Height.Highlight, AllowedBoxWidth, Height.CurrentFont * (LineCount + 1), 'HL', Line.AddEvent, 1, BoxColor, 100)
  1045.         if event ~= '' then
  1046.           do i = 0 to LineCount
  1047.             Text.Top = BoxTop + (Line + i) * Height.Highlight
  1048.             if Box == 0 then Text.Left = LeftEdge + Indent.i
  1049.             else Text.Left = LeftEdge + (AllowedBoxWidth - TextWidth.i) / 2
  1050.             TextWidth = NeededCompression.i * Width.CurrentFont
  1051.             if App == 'FW' then TextWidth = min(max(trunc(TextWidth), 4), 255)
  1052.             call PrintText(Text.Left, Text.Top, CurrentFont, 'N', TextColor, TextWidth, Text.i)
  1053.           end
  1054.  
  1055.         Day1 = Day1 + DaySpan
  1056.         if Day1 > Day2 then leave
  1057.         else if trunc((Day1 + StartDate - 1) / 7) > 4 & Day2 > MonthLength.Month then Day2 = Day1
  1058.       end
  1059.  
  1060.       if Weekly == 1 then do
  1061.         EnteredDay1 = EnteredDay1 + 7
  1062.         EnteredDay2 = EnteredDay2 + 7
  1063.       end
  1064.       else if Weekly == 2 then do
  1065.         EnteredDay1 = EnteredDay1 + 14
  1066.         EnteredDay2 = EnteredDay2 + 14
  1067.       end
  1068.     end
  1069.  
  1070.     if App == 'FW' then redraw
  1071.     else if App == 'PGS' then SELECTOBJECT None WINDOW winName
  1072.   end
  1073.  
  1074.   if Req ~= 0 then call bguiwinclose(Req)
  1075.  
  1076.   if App == 'PGS' then do
  1077.     REFRESH ON ALL
  1078.     REFRESHWINDOW WINDOW winName
  1079.     WindowRefreshed = 1
  1080.   end
  1081.  
  1082. return
  1083. /**/
  1084.  
  1085. /***//*******  Syntax () Subroutine  ***********/
  1086. Syntax:
  1087.   signal off syntax
  1088.  
  1089.   ErrorLine  = SIGL
  1090.   SourceLine = strip(SourceLine(ErrorLine))
  1091.  
  1092.   call AddMsg('E', 'Error 'RC' ('errortext(RC)')')
  1093.   call AddMsg('E', 'Line 'ErrorLine': 'SourceLine)
  1094.   call AddMsg('E', ParseVariables(SourceLine))
  1095.  
  1096.   call Cleanup
  1097.   exit
  1098. /**/
  1099.  
  1100. /***//*******  TranslationStrings () Subroutine  ***********/
  1101. TranslationStrings:
  1102. Backgrounds$    = 'Backgrounds'
  1103. Biweekly$       = 'Biweekly'
  1104. Bottom$         = 'Bottom'
  1105. BoxColor$       = 'Box:'
  1106. BoxDates$       = 'Box Dates'
  1107. Boxed$          = '_Boxed:'
  1108. Calendar$       = 'Calendar'
  1109. Cancel$         = '_Cancel'
  1110. CantFind$       = "can't be found"
  1111. CantMatch$      = "The export file can't be the"||'0a'x||"same as the preferences file"
  1112. CantOpen$       = "can't be opened"
  1113. Center$         = 'Center'
  1114. Clear$          = 'Clear'
  1115. Colors$         = 'Colors'
  1116. Critical$       = 'Critical error'
  1117. DailyColors$    = 'Use daily colors'
  1118. Easter$         = 'Easter'
  1119. End$            = 'End:'
  1120. EnterEvent$     = 'You must enter an event...'
  1121. EnterEventInfo$ = 'Enter event information:'
  1122. EnterStartdate$ = 'You must enter a start date...'
  1123. Event$          = 'Event:'
  1124. Export$         = 'E_xport'
  1125. ExportFile$     = 'Select export file:'
  1126. Exporting$      = 'Exporting'
  1127. Extended$       = 'Extended'
  1128. File$           = 'File:'
  1129. Font$           = 'Font:'
  1130. Fonts$          = 'Fonts'
  1131. ForDetails$     = 'for details'
  1132. ForwardContent$ = 'Forward contents of output to'
  1133. ForwardLog$     = 'Forward log file to'
  1134. Frequency$      = 'Frequency:'
  1135. GeneratingM$    = 'Generating %s %s calendar'
  1136. GeneratingY$    = 'Generating %s calendar'
  1137. GenMVars        = 'Month.Month EnteredYear'
  1138. GenYVars        = 'EnteredYear'
  1139. Highlights$     = 'Highlights'
  1140. Images$         = 'Images'
  1141. Julian$         = 'Julian'
  1142. JulJulLeft$     = 'Jul/Jul Left'
  1143. JulLeft$        = 'Jul Left'
  1144. Left$           = 'Left'
  1145. Line$           = '_Line:'
  1146. Load$           = '_Load'
  1147. MatchColors$    = 'Date Color = Highlight Color'
  1148. MiniCals$       = 'MiniCals'
  1149. MiscVar$        = 'Miscellaneous Variables'
  1150. Monthly$        = '_Monthly'
  1151. MustUse$        = "You must use the gadget to"||'0a'x||"the right to select a font."
  1152. Noncritical$    = 'Noncritical warning'
  1153. None$           = 'None'
  1154. NotClear$       = '<'Clear$'> can only be used for Background. variables...'
  1155. Notice$         = 'notice'
  1156. OK$             = '_OK'
  1157. Once$           = 'Once'
  1158. Options$        = 'Options'
  1159. OptLayout$      = 'Options & Layout'
  1160. OrientMarg$     = 'Orientation & Margins'
  1161. Phases$         = 'Phases'
  1162. PleaseWait$     = 'Please wait'
  1163. PrepReq$        = 'Preparing requester'
  1164. ProcessEvents$  = 'Processing events'
  1165. Reset$          = '_Reset'
  1166. Right$          = 'Right'
  1167. RiseSet$        = 'Rise/Set'
  1168. See$            = 'see'
  1169. SeeOutput$      = 'see the output above for details'
  1170. SeeShell$       = 'see the shell output for details'
  1171. SelectFile$     = 'Select data file:'
  1172. SelectFont$     = 'Select font:'
  1173. Start$          = 'Start:'
  1174. Sunrise$        = 'Sunrise'
  1175. Sunset$         = 'Sunset'
  1176. Tall$           = 'Tall'
  1177. TextColor$      = 'Text:'
  1178. Top$            = 'Top'
  1179. TopLong$        = 'Extra week at top'
  1180. Unable$         = 'if you are unable to resolve the problem.'
  1181. VarGUITitle$    = 'Set desired variables:'
  1182. Variables$      = 'Variables'
  1183. Weekly$         = 'Weekly'
  1184. Weeknumber$     = 'Weeknumber'
  1185. WholeYear$      = 'Whole _Year'
  1186. Wide$           = 'Wide'
  1187.  
  1188. January$   = 'January'
  1189. February$  = 'February'
  1190. March$     = 'March'
  1191. April$     = 'April'
  1192. May$       = 'May'
  1193. June$      = 'June'
  1194. July$      = 'July'
  1195. August$    = 'August'
  1196. September$ = 'September'
  1197. October$   = 'October'
  1198. November$  = 'November'
  1199. December$  = 'December'
  1200.  
  1201. Sunday$    = 'Sunday'
  1202. Monday$    = 'Monday'
  1203. Tuesday$   = 'Tuesday'
  1204. Wednesday$ = 'Wednesday'
  1205. Thursday$  = 'Thursday'
  1206. Friday$    = 'Friday'
  1207. Saturday$  = 'Saturday'
  1208. return 0
  1209. /**/
  1210.  
  1211. /***//*******  UpdateBusy (UB) Subroutine  ***********/
  1212. UpdateBusy:
  1213.   parse arg UB_ReqWin, UB_ProgressMade
  1214.  
  1215.   if Req ~= 0 then do
  1216.     Progress = Progress + UB_ProgressMade
  1217.  
  1218.     call bguiset(obj.OB_prog2_,UB_ReqWin,PROGRESS_Done,Progress)
  1219.     if bguiwinevent(UB_ReqWin,'ID') == id.OB_cancel_ then call Cleanup
  1220.   end
  1221.  
  1222.   return
  1223. /**/
  1224.  
  1225. /***//*******  VIO Routines () Subroutine  ***********/
  1226. /***//** OpenV() **/
  1227. OpenV:
  1228.   parse arg VIO_Variable
  1229.  
  1230.   if Open.VIO_Variable ~= 1 then do
  1231.     Open.VIO_Variable = 1
  1232.     Pointer.VIO_Variable = 1
  1233.     EOF.VIO_Variable = 0
  1234.     return 1
  1235.   end
  1236.   else return 0
  1237. /**/
  1238.  
  1239. /***//** CloseV() **/
  1240. CloseV:
  1241.   parse arg VIO_Variable
  1242.  
  1243.   If Open.VIO_Variable == 0 then return 0
  1244.   Open.VIO_Variable = 0
  1245.   return 1
  1246. /**/
  1247.  
  1248. /***//** SeekV() **/
  1249. SeekV:
  1250.   parse arg VIO_Variable, VIO_Offset, VIO_Anchor
  1251.  
  1252.   if Open.VIO_Variable == 1 then do
  1253.     VIO_Anchor = upper(left(VIO_Anchor, 1))
  1254.  
  1255.     VIO_Value = Value(VIO_Variable)
  1256.     select
  1257.       when VIO_Anchor == 'B' then Pointer.VIO_Variable = VIO_Offset
  1258.       when VIO_Anchor == 'E' then Pointer.VIO_Variable = length(VIO_Value) + VIO_Offset
  1259.       otherwise Pointer.VIO_Variable = Pointer.VIO_Variable + VIO_Offset
  1260.     end
  1261.  
  1262.     if Pointer.VIO_Variable > length(VIO_Value) then Pointer.VIO_Variable = length(VIO_Value) + 1
  1263.     return Pointer.VIO_Variable
  1264.   end
  1265.   else return 0
  1266. /**/
  1267.  
  1268. /***//** ReadVCh() **/
  1269. ReadVCh:
  1270.   parse arg VIO_Variable, VIO_Length
  1271.  
  1272.   if VIO_Length == '' then VIO_Length = 1
  1273.  
  1274.   if Open.VIO_Variable == 1 then do
  1275.     if EOF.VIO_Variable == 0 then do
  1276.       VIO_Value = Value(VIO_Variable)
  1277.       VIO_Ret = substr(VIO_Value, Pointer.VIO_Variable, VIO_Length)
  1278.       Pointer.VIO_Variable = Pointer.VIO_Variable + VIO_Length
  1279.       if Pointer.VIO_Variable > length(VIO_Value) then EOF.VIO_Variable = 1
  1280.       else EOF.VIO_Variable = 0
  1281.     end
  1282.     else VIO_Ret = ''
  1283.   end
  1284.   else VIO_Ret = ''
  1285.  
  1286.   return VIO_Ret
  1287. /**/
  1288.  
  1289. /***//** ReadVLn(RV) **/
  1290. ReadVLn:
  1291.   parse arg VIO_Variable, VIO_Count, VIO_SepChar
  1292.  
  1293.   if VIO_Count == '' then VIO_Count = 1
  1294.   if VIO_SepChar == '' then VIO_SepChar = '0a'x
  1295.  
  1296.   if Open.VIO_Variable == 1 then do
  1297.     VIO_Value = Value(VIO_Variable)
  1298.     VIO_Ret   = ''
  1299.     do VIO_i = 1 to VIO_Count
  1300.       VIO_LF = pos('0a'x, VIO_Value, Pointer.VIO_Variable)
  1301.       if VIO_LF > 0 then do
  1302.         VIO_Ret = VIO_Ret''substr(VIO_Value, Pointer.VIO_Variable, VIO_LF - Pointer.VIO_Variable)
  1303.         Pointer.VIO_Variable = VIO_LF + 1
  1304.         if VIO_LF = length(VIO_Value) then EOF.VIO_Variable = 1
  1305.         else EOF.VIO_Variable = 0
  1306.       end
  1307.       else do
  1308.         if Pointer.VIO_Variable < length(VIO_Value) then do
  1309.           VIO_Ret = VIO_Ret''substr(VIO_Value, Pointer.VIO_Variable)
  1310.           Pointer.VIO_Variable = length(VIO_Value) + 1
  1311.           EOF.VIO_Variable = 1
  1312.         end
  1313.       end
  1314.       if EOF.VIO_Variable == 1 then leave
  1315.       if VIO_i ~= VIO_Count then VIO_Ret = VIO_Ret''VIO_SepChar
  1316.     end
  1317.   end
  1318.   else VIO_Ret = ''
  1319.  
  1320.   return VIO_Ret
  1321. /**/
  1322.  
  1323. /***//** WriteVCh() **/
  1324. WriteVCh:
  1325.   parse arg VIO_Variable, VIO_String, VIO_Option
  1326.  
  1327.   VIO_Value  = Value(VIO_Variable)
  1328.   VIO_Option = upper(left(VIO_Option, 1))
  1329.   VIO_Length = length(VIO_Value)
  1330.   if VIO_Option == 'C' then do
  1331.     VIO_Value = Insert(VIO_String, VIO_Value, Pointer.VIO_Variable - 1)
  1332.     Pointer.VIO_Variable = Pointer.VIO_Variable + length(VIO_String)
  1333.   end
  1334.   else if VIO_Option == 'B' then do
  1335.     VIO_Value = VIO_String''VIO_Value
  1336.     Pointer.VIO_Variable = length(VIO_String) + 1
  1337.   end
  1338.   else do
  1339.     VIO_Value = VIO_Value''VIO_String
  1340.     Pointer.VIO_Variable = length(VIO_Value)
  1341.   end
  1342.   interpret VIO_Variable'= VIO_Value'
  1343.   if length(VIO_Value) = VIO_Length + length(VIO_String) then VIO_Ret = length(VIO_String)
  1344.   else VIO_Ret = 0
  1345.  
  1346.   return VIO_Ret
  1347. /**/
  1348.  
  1349. /***//** WriteVLn() **/
  1350. WriteVLn:
  1351.   parse arg VIO_Variable, VIO_String, VIO_Option
  1352.  
  1353.   return WriteVCh(VIO_Variable, VIO_String||'0a'x, VIO_Option)
  1354. /**/
  1355.  
  1356. /***//** EOFV() **/
  1357. EOFV:
  1358.   parse arg VIO_Variable
  1359.  
  1360.   if Open.VIO_Variable == 1 then return EOF.VIO_Variable
  1361.   else return 1
  1362. /**/
  1363. /**/
  1364.  
  1365. /***//*******  SetVariables Subroutine  ***********/
  1366. SetVariables:
  1367.  
  1368. /***//* Initialize Variables */
  1369.   AddEventRows    = 9
  1370.   ChangesFile     = 'FWC.dat'
  1371.   DataFile        = ''
  1372.   Date            = 0
  1373.   DoShanghai      = 1
  1374.   esc             = "1B"x
  1375.   EventFile       = ''
  1376.   EventKey        = 'E'
  1377.   FontKnown.      = ''
  1378.   FSize.          = 10
  1379.   HighestFont     = 5
  1380.   Highlight       = 5
  1381.   Leading         = 100
  1382.   MinWidth        = 80
  1383.   PatVar          = '#?.data'
  1384.   PrefsFile       = ''
  1385.   Req             = 0
  1386.   StartWeek       = 0
  1387.   Storage         = 'RAM:FWC/'
  1388.   TabFactor       = 3
  1389.   TabSub          = '/~'
  1390.   Width.          = 100
  1391.  
  1392.   if App == 'FW' then DefaultFont = "SoftSans"
  1393.   else if App == 'PGS' then DefaultFont = 'PageStream-Normal'
  1394.  
  1395.   TextAdj         = 0.77
  1396.   WTextArea       = 0.20  /* fraction of print height used for top of calendar (Wide) */
  1397.   TTextArea       = 0.15  /* fraction of print height used for top of calendar (Tall) */
  1398.   DateOffset      = 0.02  /* fraction of box width to offset dates from edge of box   */
  1399.  
  1400.   D.0 = 'Sunday'
  1401.   D.1 = 'Monday'
  1402.   D.2 = 'Tuesday'
  1403.   D.3 = 'Wednesday'
  1404.   D.4 = 'Thursday'
  1405.   D.5 = 'Friday'
  1406.   D.6 = 'Saturday'
  1407.  
  1408.   MonthLength.1    = 31
  1409.   MonthLength.2    = 28
  1410.   MonthLength.3    = 31
  1411.   MonthLength.4    = 30
  1412.   MonthLength.5    = 31
  1413.   MonthLength.6    = 30
  1414.   MonthLength.7    = 31
  1415.   MonthLength.8    = 31
  1416.   MonthLength.9    = 30
  1417.   MonthLength.10   = 31
  1418.   MonthLength.11   = 30
  1419.   MonthLength.12   = 31
  1420.  
  1421.   call TranslationStrings
  1422. /**/
  1423.  
  1424.   ProcessNow = 'DoShanghai Storage PrefsFile'
  1425.  
  1426.   if exists(ScriptDir''ChangesFile) then do
  1427.     call open('DataFile', ScriptDir''ChangesFile)
  1428.       do until eof('DataFile')
  1429.         Ln = ReadLn('DataFile')
  1430.         if pos(upper(word(Ln, 1)), upper(ProcessNow)) ~= 0 then interpret Ln
  1431.         else if right(word(Ln, 1), 1) == '$' then interpret Ln
  1432.         else if pos('End Pass One', Ln) > 0 then leave
  1433.       end
  1434.     call close('DataFile')
  1435.   end
  1436.  
  1437.   if (PrefsFile ~= '') & (exists(PrefsFile)) then do
  1438.     if open('DataFile', PrefsFile) then do
  1439.       do until eof('DataFile')
  1440.         Ln = ReadLn('DataFile')
  1441.         Var = upper(word(Ln, 1))
  1442.         if right(Var, 1) == '$' then interpret Ln
  1443.         else if pos('/* End Pass One', Ln) > 0 then leave
  1444.       end
  1445.       call close('DataFile')
  1446.     end
  1447.     Month.1  = January$
  1448.     Month.2  = February$
  1449.     Month.3  = March$
  1450.     Month.4  = April$
  1451.     Month.5  = May$
  1452.     Month.6  = June$
  1453.     Month.7  = July$
  1454.     Month.8  = August$
  1455.     Month.9  = September$
  1456.     Month.10 = October$
  1457.     Month.11 = November$
  1458.     Month.12 = December$
  1459.   end
  1460.  
  1461.   call makedir(left(Storage, length(Storage) - 1))
  1462.   call GetLogInfo
  1463.  
  1464.   if App == 'FW' then do
  1465.     call open('FWPrefs', CurrentDir'FWFiles/FW.Prefs')
  1466.       FWPrefs = readch('FWPrefs', 65535)
  1467.     call close('FWPrefs')
  1468.     ColorTable = pos('SWCL', FWPrefs) + 12
  1469.     EndTable = pos('STUP', FWPrefs)
  1470.     ColorCount = 0
  1471.     Do CTPos = ColorTable to EndTable by 20
  1472.       ColorRegister = c2x(substr(FWPrefs, CTPos - 3, 3))
  1473.       ColorList.ColorCount = strip(substr(FWPrefs, CTPos, 16), 'B', '00'x)
  1474.       if ColorRegister = '000000' then Black$ = ColorList.ColorCount
  1475.       if ColorRegister = 'FFFFFF' then White$ = ColorList.ColorCount
  1476.       ColorCount = ColorCount + 1
  1477.     end
  1478.     ColorList.ColorCount = '<'Clear$'>'
  1479.     ColorCount = ColorCount + 1
  1480.     ColorList.COUNT = ColorCount
  1481.     if symbol('Black$') == 'LIT' then do
  1482.       call AddMsg('W', "The color black can't be found; "ColorList.0" used instead.")
  1483.       Black$ = ColorList.0
  1484.     end
  1485.     if symbol('White$') == 'LIT' then do
  1486.       call AddMsg('W', "The color white can't be found; "ColorList.1" used instead.")
  1487.       White$ = ColorList.1
  1488.     end
  1489.   end
  1490.   else if App == 'PGS' then do
  1491.     GETFONTLIST FontList
  1492.     FontList.COUNT = result
  1493.  
  1494.     call open('PGSColors', CurrentDir''word(PgmVersion, 1)'.colors')
  1495.       PGSColors = readch('PGSColors', 65535)
  1496.     call close('PGSColors')
  1497.     ColorCount = 0
  1498.     StartTag = pos('TG'||'00'x, PGSColors)
  1499.     do while StartTag ~= 0
  1500.       Color = substr(PGSColors, StartTag + 10, c2d(substr(PGSColors, StartTag + 9, 1)))
  1501.       AccentMarker = pos(d2c(129), Color)
  1502.       do while AccentMarker > 0
  1503.         Color = overlay(d2c(c2d(substr(Color, AccentMarker + 1, 1)) + 128), delstr(Color, AccentMarker, 1), AccentMarker)
  1504.         AccentMarker = pos(d2c(129), Color)
  1505.       end
  1506.       ColorList.ColorCount = Color
  1507.       ColorCount = ColorCount + 1
  1508.       StartTag = pos('TG'||'00'x, PGSColors, StartTag + 10)
  1509.     end
  1510.     ColorList.ColorCount = '<'Clear$'>'
  1511.     ColorCount = ColorCount + 1
  1512.     ColorList.COUNT = ColorCount
  1513.     White$ = ColorList.0
  1514.     Black$ = ColorList.1
  1515.   end
  1516.   TextColorList.Count = ColorList.COUNT - 1
  1517.   do i = 0 to TextColorList.Count - 1
  1518.     TextColorList.i = ColorList.i
  1519.   end
  1520.  
  1521.   Color.          = Black$
  1522.   Line.           = Black$
  1523.   Background.     = White$
  1524.  
  1525.   AppScreen = ''
  1526.   DefPubScreen = ''
  1527.   if RexxTricks == 1 then do
  1528.     if (pubscreenlist('ScreenList') > 0) then do
  1529.       do i = 1 to ScreenList.0
  1530.         if pos(AppName, upper(ScreenList.i)) > 0 then do
  1531.           AppScreen = ScreenList.i
  1532.           leave
  1533.         end
  1534.       end
  1535.     end
  1536.   end
  1537.  
  1538.  
  1539.   /**** Read user variables ****/
  1540.   if App == 'FW' then do
  1541.     FIRSTOBJECT; TempDateID = result
  1542.     do forever
  1543.       if TempDateID == 0 then do
  1544.         call AddMsg('E', 'Unable to find FWC date string.')
  1545.         call AddMsg('E', 'Make sure a Monthly calendar created by FWCalendar.rexx is currently loaded.')
  1546.         call Cleanup
  1547.       end
  1548.       GETOBJECTTYPE TempDateID; ObjectType = result
  1549.       if ObjectType == 7 then do
  1550.         GETTEXTBLOCKTEXT TempDateID; TempDate = result
  1551.         if (left(TempDate, 3) == 'FWC') & (datatype(substr(TempDate, 4, 8)) == 'NUM') then leave
  1552.       end
  1553.       NEXTOBJECT TempDateID; TempDateID = result
  1554.     end
  1555.     do while right(TempDate, 1) == '|'
  1556.       StartObj = pos('|', TempDate)
  1557.       NextObj = strip(substr(TempDate, StartObj), 'B', '|')
  1558.       GETTEXTBLOCKTEXT NextObj; TempDate = left(TempDate, StartObj - 1)''result
  1559.     end
  1560.     PrefsFile = substr(TempDate, 12)
  1561.     TempDate = substr(TempDate, 4, 8)
  1562.   end
  1563.   else if App = 'PGS' then do
  1564.     CURRENTWINDOW; winName = '"'RESULT'"'
  1565.     SELECTTEXT at 0 0 WINDOW winName
  1566.     SELECTTEXT ALL WINDOW winName
  1567.     EXPORTTEXT AMIGA FILE Storage"TempDate.txt" FILTER "ASCII" STATUS FORCE
  1568.     if exists(Storage"TempDate.txt") then do
  1569.       open(TDFile, Storage"TempDate.txt")
  1570.         TempDate = ReadLn(TDFile)
  1571.       close(TDFile)
  1572.     end
  1573.     if (left(TempDate, 3) ~= 'FWC') | (datatype(substr(TempDate, 4, 8)) ~= 'NUM') then do
  1574.       call AddMsg('E', 'Unable to find FWC date string.')
  1575.       call AddMsg('E', 'Make sure a Monthly calendar created by FWCalendar.rexx is currently loaded.')
  1576.       call Cleanup
  1577.     end
  1578.     else do
  1579.       PrefsFile = substr(TempDate, 12)
  1580.       TempDate = substr(TempDate, 4, 8)
  1581.     end
  1582.   end
  1583.   if PrefsFile == '' then do
  1584.     if exists(ScriptDir''FWCData) then PrefsFile = ScriptDir''FWCData
  1585.     else PrefsFile = 'Default'
  1586.   end
  1587.  
  1588.   call open('Temp', FullCallPath)
  1589.     FileOffset = 40000
  1590.     call seek('Temp', FileOffset, 'B')
  1591.     do until (EndPos ~= 0) | (PrevOffset = FileOffset)
  1592.       PrevOffset = FileOffset
  1593.       Chunk = readch('Temp', 65535)
  1594.       EndPos = pos('VarList:'||'0a'x, Chunk)
  1595.       if EndPos == 0 then FileOffset = seek('Temp', -10, 'C')
  1596.     end
  1597.     call seek('Temp', FileOffset + EndPos + 8, 'B')
  1598.     DefaultVariables = readch('Temp', 65535)
  1599.   call close('Temp')
  1600.   call openv('DefaultVariables')
  1601.     do forever
  1602.       CD_VarLine = strip(readvln('DefaultVariables'))
  1603.       if CD_VarLine == 'return' then leave
  1604.       if CD_VarLine == '' then iterate
  1605.       interpret CD_VarLine
  1606.     end
  1607.   call closev('DefaultVariables')
  1608.  
  1609.   if (PrefsFile ~= 'Default') & (exists(PrefsFile)) then do
  1610.     if open('UserFile', PrefsFile) then do
  1611.       UserFile = readch('UserFile', 65535)
  1612.       call close('UserFile')
  1613.       call openv('UserFile')
  1614.         do until eofv('UserFile')
  1615.           CD_VarLine = strip(ReadvLn('UserFile'))
  1616.           CD_VarName = upper(strip(word(CD_VarLine, 1)))
  1617.           if left(CD_VarLine, 15) == '/* End Pass One' then leave
  1618.           if (left(CD_VarLine, 2) == '/*') |,
  1619.              (CD_VarName == 'DOSHANGHAI') |,
  1620.              (CD_VarLine == '') |,
  1621.              (upper(left(CD_VarLine, 11)) == 'IMAGECLASS.') then iterate
  1622.           else interpret CD_VarLine
  1623.         end
  1624.       call closev('UserFile')
  1625.     end
  1626.   end
  1627.   drop Orientation
  1628.  
  1629.   if RexxTricks == 1 then do
  1630.     if DoShanghai ~= 0 then PubScreen = AppScreen
  1631.     else PubScreen = DefPubScreen
  1632.   end
  1633.  
  1634.   Type.0    = Event$
  1635.   Type.1    = File$
  1636.   FSize.4pt = 4
  1637.  
  1638.   do i = 0 to 6
  1639.     val = i - StartWeek
  1640.     if val < 0 then val = 7 + val
  1641.     interpret 'Day.'D.i '=' val
  1642.     interpret 'Day.val = 'D.i'$'
  1643.   end
  1644.  
  1645.   Month.1  = January$
  1646.   Month.2  = February$
  1647.   Month.3  = March$
  1648.   Month.4  = April$
  1649.   Month.5  = May$
  1650.   Month.6  = June$
  1651.   Month.7  = July$
  1652.   Month.8  = August$
  1653.   Month.9  = September$
  1654.   Month.10 = October$
  1655.   Month.11 = November$
  1656.   Month.12 = December$
  1657.  
  1658.   do i = 1 to 12
  1659.     AbbrMonth.i  = left(Month.i, 3)
  1660.   end
  1661.  
  1662.   if App == 'FW' then do
  1663.     TextBase = TextAdj
  1664.     do i = 0 to 5 by 5
  1665.       if Font.i == NameOnly(Font.i) then Font.i = CurrentDir'FWFonts/SWOLFonts/'Font.i
  1666.       if ~exists(Font.i) then do
  1667.         call AddMsg('W', NameOnly(Font.i)" can't be found; "DefaultFont" used instead.")
  1668.         Font.i = DefaultFont
  1669.       end
  1670.     end
  1671.     GETPAGESETUP ORIENT; FWC_Orientation = result
  1672.     if FWC_Orientation == 'Wide' then TextArea = WTextArea
  1673.     else TextArea = TTextArea
  1674.  
  1675.     GETDISPLAYPREFS Measure; UserPrefs = 'DISPLAYPREFS Measure 'result
  1676.     DISPLAYPREFS Measure Inches
  1677.     GETSECTIONSETUP Top Bottom Inside Outside
  1678.     parse var result Margin.Top Margin.Bottom Margin.Left Margin.Right
  1679.  
  1680.     GETPAGESETUP Width Height
  1681.     parse var result FullWidth FullHeight
  1682.  
  1683.     TextBlockPrefs TEXTFLOW None
  1684.   end
  1685.   else if App = 'PGS' then do
  1686.     TextBase = 1
  1687.     GETFONTLIST FontNames
  1688.     FontNames.COUNT = result
  1689.     do i = 0 to 5 by 5
  1690.       do j = 0 to FontNames.COUNT - 1
  1691.         if upper(Font.i) == upper(FontNames.j) then leave
  1692.       end
  1693.       if j == FontNames.COUNT then do
  1694.         call AddMsg('W', Font.i" can't be found; "DefaultFont" used instead.")
  1695.         Font.i = DefaultFont
  1696.       end
  1697.     end
  1698.     GETMASTERPAGES MPage; PageName = MPage.0
  1699.     GETMEASUREMENTS COORDINATE stemc RELATIVE rel TEXT tex FROM fro
  1700.     UserPrefs = 'SETMEASUREMENTS COORDINATE 'stemc.horizontal stemc.vertical' RELATIVE 'rel' TEXT 'tex' FROM 'fro
  1701.     SETMEASUREMENTS COORDINATE Inches Sameas RELATIVE Sameas TEXT Points FROM Page
  1702.     GETMARGINGUIDES temp
  1703.     Margin.Left   = temp.inside
  1704.     Margin.Right  = temp.outside
  1705.     Margin.Top    = temp.top
  1706.     Margin.Bottom = temp.bottom
  1707.  
  1708.     GETDIMENSIONS layout MASTERPAGE "'"PageName"'"
  1709.     if layout.orientation == 'LANDSCAPE' then do
  1710.       TextArea   = WTextArea
  1711.       FullWidth  = layout.height
  1712.       FullHeight = layout.width
  1713.     end
  1714.     else do
  1715.       TextArea   = TTextArea
  1716.       FullWidth  = layout.width
  1717.       FullHeight = layout.height
  1718.     end
  1719.   end
  1720.  
  1721.   PrintWidth       = FullWidth - Margin.Left - Margin.Right
  1722.   PrintHeight      = FullHeight - Margin.Top - Margin.Bottom
  1723.  
  1724.   if App == 'FW' then do
  1725.     GETOBJECTCOORDS TempDateID; Parse Var result . . . . Height.4pt
  1726.   end
  1727.   else if App == 'PGS' then Height.4pt = GetHeight(4pt)
  1728.   if ((PrintHeight - Height.4pt - (TextArea * PrintHeight))/5 * 8) >= 4 then
  1729.       PrintHeight = PrintHeight - Height.4pt
  1730.  
  1731.   BoxWidth         = PrintWidth/7
  1732.   CalRight         = Margin.Left + BoxWidth * 7
  1733.   TextArea         = TextArea * PrintHeight
  1734.   CalTop           = TextArea + Margin.Top
  1735.   BoxHeight        = (PrintHeight - TextArea)/5
  1736.   DateOffset       = DateOffset * BoxWidth
  1737.   FSize.Date       = BoxHeight/HighlightRows * 72 * StretchDateH
  1738.   Width.Date       = Width.Date * StretchDateW / StretchDateH
  1739.   FSize.Highlight  = BoxHeight/AddEventRows * 72
  1740.   if App == 'FW' then FSize.Highlight = max(trunc(FSize.Highlight), 4)
  1741.   if App == 'FW' then FSize.Date = max(trunc(FSize.Date), 4)
  1742.   Height.Highlight = GetHeight(Highlight) * Leading/100
  1743.   Height.Date      = GetHeight(Date) * Leading/100
  1744.  
  1745.   FontInfo = compress(Font.Highlight''FSize.Highlight, '. /:')
  1746.   FontKnown.FontInfo = Highlight
  1747.  
  1748.   RowsThatFit      = trunc(BoxHeight / Height.Highlight + 0.05)
  1749.   Width.WidthOfDate1 = GetFontWidth(Date, '1')
  1750.   Width.WidthOfDate8 = GetFontWidth(Date, '8')
  1751.   VariablesSet = 1
  1752. return
  1753. /**/
  1754.  
  1755. /***//*******  VarList () Subroutine  ***********/
  1756. ReturnVarListLoc:
  1757.   return SIGL + 2
  1758. VarListLoc:
  1759.   /* WTextArea      = fraction of print height used for top of calendar (Wide) */
  1760.   /* TTextArea      = fraction of print height used for top of calendar (Tall) */
  1761.   /* DateOffset     = fraction of box width to offset dates from edge of box   */
  1762.   /* MiniCalHeight  = fraction of text area height used for minicals           */
  1763.   /* MiniCalWidth   = width-to-height ratio for minicals                       */
  1764.   /* MiniCalSpacing = fraction of print width placed between FY minicals       */
  1765.   signal ReturnVarListLoc
  1766. VarList:
  1767.   AddEventRows          = 9
  1768.   AdjustDST             = 1
  1769.   AltColor.Date         = Black$
  1770.   AltColor.Extended     = Black$
  1771.   AltColor.Highlight    = Black$
  1772.   AltColor.HighlightH   = Black$
  1773.   AltColor.Julian       = Black$
  1774.   AltColor.Sunrise      = Black$
  1775.   AltColor.Sunset       = Black$
  1776.   AltColor.WeekNumber   = Black$
  1777.   Background.AddEvent   = White$
  1778.   Background.Highlight  = White$
  1779.   Background.HighlightH = White$
  1780.   Background.MiniCal    = White$
  1781.   Background.Weekend    = White$
  1782.   BelzierFactor         = .55
  1783.   Bold.FYMiniCal        = DefaultBold
  1784.   Bold.MiniCal          = DefaultBold
  1785.   CenterMiniDates       = 1
  1786.   Clear$                = 'Clear'
  1787.   Color.AddEvent        = Black$
  1788.   Color.Date            = Black$
  1789.   Color.Extended        = Black$
  1790.   Color.Friday          = Black$
  1791.   Color.Header          = Black$
  1792.   Color.Highlight       = Black$
  1793.   Color.HighlightH      = Black$
  1794.   Color.Julian          = Black$
  1795.   Color.MiniCal         = Black$
  1796.   Color.Monday          = Black$
  1797.   Color.Moon            = Black$
  1798.   Color.Saturday        = Black$
  1799.   Color.Sunday          = Black$
  1800.   Color.Sunrise         = Black$
  1801.   Color.Sunset          = Black$
  1802.   Color.Thursday        = Black$
  1803.   Color.Tuesday         = Black$
  1804.   Color.Wednesday       = Black$
  1805.   Color.Weekday         = Black$
  1806.   Color.WeekNumber      = Black$
  1807.   DateOffset            = 0.02
  1808.   DoBackgrounds         = 0
  1809.   DoDailyColors         = 0
  1810.   DoDateBox             = 0
  1811.   DoEaster              = 1
  1812.   DoExtended            = 1
  1813.   DoHighlights          = 0
  1814.   DoImages              = 0
  1815.   DoJulian              = 0
  1816.   DoJulianLeft          = 0
  1817.   DoMatchColors         = 0
  1818.   DoMiniCals            = 1
  1819.   DoPhases              = 0
  1820.   DoSunRise             = 0
  1821.   DoSunSet              = 0
  1822.   DoTopExtraWk          = 0
  1823.   DoWeekNumber          = 0
  1824.   FinalView             = 75
  1825.   Font.Date             = DefaultFont
  1826.   Font.Extras           = DefaultFont
  1827.   Font.FYMiniCal        = DefaultFont
  1828.   Font.Header           = DefaultFont
  1829.   Font.Highlight        = DefaultFont
  1830.   Font.MiniCal          = DefaultFont
  1831.   Font.Weekday          = DefaultFont
  1832.   GfxAppPath            = ''
  1833.   HeaderLoc             = 2
  1834.   HighlightRows         = 9
  1835.   LaunchM               = ''
  1836.   LaunchY               = ''
  1837.   Leading               = 100
  1838.   Line.AddEvent         = Black$
  1839.   Line.Extended         = Black$
  1840.   Line.Grid             = Black$
  1841.   Line.MiniCal          = Black$
  1842.   MagnifyExtras         = 1
  1843.   Margin.Bottom         = 0
  1844.   Margin.Left           = 0
  1845.   Margin.Right          = 0
  1846.   Margin.Top            = 0
  1847.   MaxImgHeight          = .75
  1848.   MaxImgWidth           = .75
  1849.   MiniCalHeight         = 0.60
  1850.   MiniCalSpacing        = 0.05
  1851.   MiniCalWidth          = 2
  1852.   MinWidth              = 80
  1853.   MoonRadius            = .075
  1854.   Orientation           = 'Wide'
  1855.   ShiftLMini            = 0
  1856.   ShiftRMini            = 0
  1857.   StartWeek             = 0
  1858.   StretchDateH          = 1
  1859.   StretchDateW          = 1
  1860.   SunCalcPath           = ''
  1861.   Text.Julian           = ''
  1862.   Text.Sunrise          = ''
  1863.   Text.Sunset           = ''
  1864.   Text.WeekNumber       = ''
  1865.   Width.Date            = 100
  1866. return
  1867. /**/
  1868.  
  1869.